Loadstar 77/077.d81/hi source

Commodore BASIC | 2022-08-26 | 10KB | 669 lines

5 open4,4,7
10 sys700
20 .opt p4
30 *= $c700
40 ffd2 =$ffd2
50 getin =$ffe4
60 base =$a000
70 jmp start
80 lcount =*
90 .byte 0:eof =*:.byte 0,0
100 temp =*
110 .byte 0
120 col =*
130 .byte 3
140 fade =*
150 .byte 15,15,12,11,0
160 pretty =*
170 .byte 0,0
180 menu =*
190 .asc "[195][210][211][210] up/down [159]page [195][159] color [209][159] exit":.byte 0
200 prlen =*:.byte 0,0
210 prloc =*:.byte 0,0
220 page =*:.byte 0
230 curpage =*:.byte 0
240 border =*:.byte 0
250 backgr =*:.byte 0
260 start jsr $aefd
270 jsr $ad9e
280 jsr $b6a3
290 ldx $22
300 ldy $23
310 jsr $ffbd
320 loadfile lda #1
330 ldx #8
340 ldy #0
350 jsr $ffba
360 lda #0
370 ldx #<base
380 ldy #>base
390 jsr $ffd5
400 stx eof
410 sty eof+1
420 storzero stx 251
430 sty 252
440 ldy #0
450 tya
460 sta (251),y
470 lda 53280
480 sta border
490 lda 53281
500 sta backgr
510 ldy #0
520 sty 53280
530 sty 53281
540 jsr $aefd
550 jsr $ad9e
560 jsr $b6a3
570 ldx $22:stx prloc
580 ldy $23:sty prloc+1
590 ldx #23
600 sta prlen
610 lsr
620 sta prlen+1
630 lda #20
640 sec
650 sbc prlen+1
660 sta prlen+1
670 jsr figureit
680 lda 1
690 ora #1
700 sta 1
710 jsr videoin
720 lda #"[147]"
730 jsr $ffd2
740 lda #1
750 sta 646
760 lda #"[162]"
770 ldy #39
780 topline jsr $ffd2
790 dey
800 bpl topline
810 lda #3
820 sta 199
830 sta 646
840 lda #32
850 ldy #119
860 line2 jsr $ffd2
870 dey
880 bpl line2
890 lda #0
900 sta curpage
910 sta 199
920 lda #11
930 sta 646
940 lda #"[184]"
950 ldy #39
960 line3 jsr $ffd2
970 dey
980 bpl line3
990 lda #6
1000 sta 646
1010 lda #"[176]"
1020 jsr $ffd2
1030 ldy #37
1040 lda #"[192]"
1050 sigh jsr $ffd2
1060 dey
1070 bpl sigh
1080 lda #"[174]"
1090 jsr $ffd2
1100 ldx #15
1110 mainarea ldy #37
1120 lda #"[221]"
1130 jsr $ffd2
1140 lda #3
1150 sta 646
1160 lda #32
1170 ma1 jsr $ffd2
1180 dey
1190 bpl ma1
1200 lda #6
1210 sta 646
1220 lda #"[221]"
1230 jsr $ffd2
1240 dex
1250 bpl mainarea
1260 lda #"[173]"
1270 jsr $ffd2
1280 lda #"[192]"
1290 ldy #37
1300 ma3 jsr $ffd2
1310 dey
1320 bpl ma3
1330 lda #"[189]"
1340 jsr $ffd2
1350 links ldy #25
1360 linelink lda 217,y
1370 ora #128
1380 sta 217,y
1390 dey
1400 bpl linelink
1410 stx 251
1420 sty 252
1430 ldy #3:ldx #23
1440 clc
1450 jsr $fff0
1460 ldy #0
1470 smenu lda menu,y
1480 beq spretty
1490 jsr $ffd2
1500 iny
1510 jmp smenu
1520 spretty ldx #3
1530 stx 199
1540 stx 646
1550 ldx #2
1560 ldy prlen+1
1570 clc:jsr $fff0
1580 lda prloc
1590 sta 251
1600 lda prloc+1
1610 sta 252
1620 ldy #0
1630 showpret lda (251),y
1640 jsr $ffd2
1650 iny
1660 cpy prlen
1670 bne showpret
1680 main lda #<base
1690 sta 251
1700 lda #>base
1710 sta 252
1720 showpage ldx #6
1730 ldy #1
1740 clc
1750 jsr $fff0
1760 lda #0
1770 sta 646
1780 ldy #0
1790 sty lcount
1800 sty 199
1810 getit lda 1
1820 and #254
1830 sta 1
1840 sei
1850 getdata lda (251),y
1860 beq interupt
1870 cmp #13
1880 beq its13
1890 jmp print
1900 its13 jsr carriage
1910 lda lcount
1920 cmp #16
1930 bne getdata
1940 interupt cli
1950 lda 1
1960 ora #1
1970 sta 1
1980 jsr fadein
1990 jsr prinpage
2000 scankey jsr getin
2010 cmp #0
2020 beq scankey
2030 cmp #""
2040 bne cup
2050 jsr flipup
2060 jsr fadeout
2070 jmp showpage
2080 cup cmp #"[145]"
2090 bne chcol
2100 jsr flipdown
2110 jsr fadeout
2120 jmp showpage
2130 chcol cmp #"c"
2140 bne chhome
2150 jsr color
2160 jmp scankey
2170 chhome cmp #""
2180 bne chshift
2190 jsr fadeout
2200 lda #1
2210 sta curpage:jsr flipdown
2220 jmp showpage
2230 chshift cmp #"[147]"
2240 bne chquit
2250 ldx page
2260 stx curpage
2270 jsr fadeout
2280 jsr flipup
2290 jmp showpage
2300 chquit cmp #"q"
2310 bne chprt
2320 jmp quit
2330 chprt cmp #"p"
2340 bne ahwell
2350 jsr prompt
2360 jsr clear
2370 jmp links
2380 ahwell jmp scankey
2390 print jsr $ffd2
2400 jsr bump
2410 jmp getit
2420 quit lda 1
2430 ora #1
2440 sta 1
2450 jsr videoout
2460 rts
2470 carriage jsr $ffd2
2480 lda #""
2490 jsr bump
2500 jsr $ffd2
2510 inc lcount
2520 rts
2530 color inc col
2540 lda col
2550 and #15
2560 sta col:sta 646
2570 cmp #0
2580 beq color
2590 cwait lda 53265
2600 bpl cwait
2610 ldy #37
2620 lda col
2630 wcolor sta 1265+54272,y
2640 sta 1305+54272,y
2650 sta 1345+54272,y
2660 sta 1385+54272,y
2670 sta 1425+54272,y
2680 sta 1465+54272,y
2690 sta 1505+54272,y
2700 sta 1545+54272,y
2710 sta 1585+54272,y
2720 sta 1625+54272,y
2730 sta 1665+54272,y
2740 sta 1705+54272,y
2750 sta 1745+54272,y
2760 sta 1785+54272,y
2770 sta 1825+54272,y
2780 sta 1865+54272,y
2790 dey
2800 bpl wcolor
2810 rts
2820 bump inc 251
2830 beq bump2
2840 rts
2850 bump2 inc 252
2860 rts
2870 clear lda 53265
2880 bpl clear
2890 ldy #37
2900 lda #32
2910 wipe sta 1265,y
2920 sta 1305,y
2930 sta 1345,y
2940 sta 1385,y
2950 sta 1425,y
2960 sta 1465,y
2970 sta 1505,y
2980 sta 1545,y
2990 sta 1585,y
3000 sta 1625,y
3010 sta 1665,y
3020 sta 1705,y
3030 sta 1745,y
3040 sta 1785,y
3050 sta 1825,y
3060 sta 1865,y
3070 dey
3080 bpl wipe
3090 rts
3100 figureit lda 1
3110 and #254
3120 sta 1
3130 lda #<base
3140 sta 251:sta ptable
3150 lda #>base
3160 sta 252:sta ptable+1
3170 ldy #0
3180 ldx #0
3190 stx page
3200 apage lda (251),y
3210 bne ckrt
3220 rts
3230 ckrt cmp #13
3240 bne incpage
3250 jsr found
3260 incpage inc 251
3270 beq bpage
3280 jmp apage
3290 bpage inc 252
3300 jmp apage
3310 found inx
3320 cpx #15
3330 bne foundout
3340 ldx #0
3350 inc page
3360 inc 251
3370 bne cpage
3380 inc 252
3390 cpage lda page
3400 asl
3410 tax
3420 lda 251
3430 sta ptable,x
3440 lda 252
3450 inx
3460 sta ptable,x
3470 ldx #0
3480 foundout rts
3490 flipup lda curpage
3500 cmp page
3510 bne ghead
3520 jmp chpage
3530 ghead inc curpage
3540 chpage lda curpage
3550 asl
3560 tax
3570 lda ptable,x
3580 sta 251
3590 inx
3600 lda ptable,x
3610 sta 252
3620 rts
3630 flipdown lda curpage
3640 bne sokay
3650 jmp chpage
3660 sokay dec curpage
3670 jmp chpage
3680 fadeout lda col
3690 sta temp
3700 sei
3710 ldx #0
3720 floop lda fade,x
3730 sta col
3740 jsr cwait
3750 inx
3760 cpx #5
3770 bne floop
3780 fout jsr clear
3790 lda temp
3800 sta col
3810 cli:rts
3820 fadein lda col
3830 sta temp
3840 ldx #5
3850 sei
3860 filoop lda fade,x
3870 sta col
3880 jsr cwait
3890 dex
3900 bne filoop
3910 lda temp
3920 sta col
3930 jsr cwait
3940 cli:rts
3950 prinpage ldx #24
3960 ldy #17
3970 clc
3980 jsr $fff0
3990 lda #12
4000 sta 646
4010 ldx curpage
4020 inx
4030 lda #0
4040 sta 199
4050 clc
4060 jsr $bdcd
4070 lda #" "
4080 jsr $ffd2
4090 lda #"o"
4100 jsr $ffd2
4110 lda #"f"
4120 jsr $ffd2
4130 lda #" "
4140 jsr $ffd2
4150 lda #0
4160 ldx page
4170 inx
4180 jsr $bdcd
4190 lda #" "
4200 jsr $ffd2
4210 lda #"[145]"
4220 jmp $ffd2
4230 videoin lda #0
4240 sta 251
4250 sta 253
4260 lda #>1024
4270 sta 252
4280 lda #>$e000
4290 sta 254
4300 jsr copy
4310 lda #>$d800
4320 sta 252
4330 lda #>$e400
4340 sta 254
4350 jsr copy
4360 rts
4370 videoout lda #0
4380 sta 251
4390 sta 253
4400 lda #>$e000
4410 sta 252
4420 lda #>$0400
4430 sta 254
4440 jsr copy
4450 lda #>$e400
4460 sta 252
4470 lda #>$d800
4480 sta 254
4490 jsr copy
4500 lda border
4510 sta 53280
4520 lda backgr
4530 sta 53281
4540 rts
4550 copy ldx #3
4560 ldy #0
4570 sei
4580 lda 1
4590 and #253
4600 sta 1
4610 copya lda (251),y
4620 sta (253),y
4630 iny
4640 bne copya
4650 inc 252
4660 inc 254
4670 dex
4680 bpl copya
4690 lda 1
4700 ora #2
4710 sta 1
4720 cli
4730 rts
4740 printout jsr openptr
4750 lda #4
4760 jsr $ffc3 ;close file
4770 jsr $ffb7  ;readst
4780 bpl (NULL)ahead
4790 flash inc 53281
4800 lda 197
4810 cmp #64
4820 bne flash
4830 lda #0
4840 sta 53281
4850 rts
4860 (NULL)ahead jsr openptr
4870 ldx #4    ; file number
4880 jsr $ffc9 ; output to file #4
4890 lda #1
4900 sta pos
4910 sta wordlen
4920 sta endpflag
4930 sta retcount
4940 inc retcount
4950 lda #" "
4960 ldx #4
4970 stx line
4980 jsr repeat
4990 jsr leftmrgn ;position printer
5000 jsr setprt
5010 here(NULL)es jsr findword ;find a word
5020 jsr printwrd ;print the word
5030 jsr advcntr ;advance hi/lo pointer
5040 ldx 197
5050 cpx #10
5060 beq formfeed
5070 ldx endpflag
5080 bpl here(NULL)es;if not end then loop
5090 formfeed lda #13
5100 jsr $ffd2
5110 inc line
5120 lda line
5130 cmp #69
5140 bcc formfeed
5150 lda #4
5160 jsr $ffc3:dec 154
5170 rts
5180 openptr lda #4; file